;; The first four lines of this file were added by Dracula.
;; They tell DrScheme that this is a Dracula Modular ACL2 program.
;; Leave these lines unchanged so that DrScheme can properly load this file.
#reader(planet "reader.rkt" ("cce" "dracula.plt") "modular" "lang")
(require "IAVLtree.lisp")
(require "Irng.lisp")
(require "Iformulas.lisp")

(module MAVLtree
  
  (import Irng)
  (import Iformulas)
  (include-book "list-utilities" :dir :teachpacks)
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;AVL Tree Outer
  ;   This is the section for the outer AVL tree.  
  ;   It stores the key in the format of (Group #, Group Score)
  ;
  ;   - This is a modification of the original AVL Tree
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun empty-tree? (tr) (not (consp tr)))
  (defun height (tr) (if (empty-tree? tr) 0 (car tr)))
  (defun key (tr) (cadr tr))
  (defun data (tr) (caddr tr))
  (defun left (tr) (cadddr tr))
  (defun right (tr) (car (cddddr tr)))
  (defun keys (tr)
    (if (empty-tree? tr)
        nil
        (append (keys (left tr)) (list (key tr)) (keys (right tr)))))
  
  ;key check for avl-outer tree 
  ;checks to see if the score is less.  if scores are equal, it then compares the group id's
  (defun check-if-less (j k)
    (if (< (car (cdr j)) (car (cdr k)))
        t
        (if (< (car j) (car k))
            t
            nil))     
    )
  
  
  ; Constructors
  (defun empty-tree ( ) nil)
  (defun tree (k d lf rt)
    (list (+ 1 (max (height lf) (height rt))) k d lf rt)) 
  
  ; Contstraint detectors and key comparators
  ;(defun key? (k) (rationalp k))	 ; to change representation of keys
  ;(defun key< (j k) (< j k))	  ;    alter definitions of key? and key<
  
  (defun key? (k)
    (and (rationalp (car k))));(car (cdr (car k))))))	 ; to change representation of keys
  
  (defun key< (j k)  ;    alter definitions of key? and key<
    (check-if-less j k))
  ;(< j k))	  
  
  (defun key> (j k) (key< k j))
  (defun key= (j k)		  ; note: definitions of
    (and (not (key< j k))           ;    key>, key=, and key-member	
         (not (key> j k))))	  ;        get in line automatically
  (defun key-member (k ks)
    (and (consp ks)
         (or (key= k (car ks))
             (key-member k (cdr ks)))))
  (defun data? (d)
    (if d t t))
  (defun tree? (tr)
    (or (empty-tree? tr)
        (and (natp (height tr))		       ; height
             (= (height tr)                      ;   constraints
                (+ 1 (max (height (left tr))
                          (height (right tr)))))
             (key? (key tr))                     ; key constraint
             (data? (data tr))                   ; data constraint
             (tree? (left tr))                   ; subtree
             (tree? (right tr)))))               ;   constraints
  
  ; Key occurs in tree detector
  (defun occurs-in-tree? (k tr)
    (and (key? k)
         (tree? tr)
         (key-member k (keys tr))))
  (defun alternate-occurs-in-tree? (k tr)
    (and (key? k)
         (tree? tr)
         (not (empty-tree? tr))
         (or (key= k (key tr))
             (alternate-occurs-in-tree? k (left tr))
             (alternate-occurs-in-tree? k (right tr)))))
  
  ; all-key comparators
  (defun all-keys< (k ks)
    (or (not (consp ks))
        (and (key< (car ks) k) (all-keys< k (cdr ks)))))
  
  (defun all-keys> (k ks)
    (or (not (consp ks))
        (and (key> (car ks) k) (all-keys> k (cdr ks)))))
  
  ; definitions of ordered and balanced, and avl-tree detector
  (defun ordered? (tr)
    (or (empty-tree? tr)
        (and (tree? tr)
             (all-keys< (key tr) (keys (left tr)))
             (all-keys> (key tr) (keys (right tr)))
             (ordered? (left tr))
             (ordered? (right tr)))))
  
  (defun balanced? (tr)
    (and (tree? tr)
         (or (empty-tree? tr)
             (and (<= (abs (- (height (left tr)) 
                              (height (right tr)))) 1)
                  (balanced? (left tr))
                  (balanced? (right tr))))))
  
  (defun avl-tree? (tr)
    (and (ordered? tr)
         (balanced? tr)))
  
  ; rotations
  (defun easy-R (tr)
    (let* ((z (key tr)) (dz (data tr))
                        (zL (left tr)) (zR (right tr))
                        (x (key zL)) (dx (data zL))
                        (xL (left zL)) (xR (right zL)))
      (tree x dx xL (tree z dz xR zR))))
  
  (defun easy-L (tr)
    (let* ((z (key tr)) (dz (data tr))
                        (zL (left tr)) (zR (right tr))
                        (x (key zR)) (dx (data zR))
                        (xL (left zR)) (xR (right zR)))
      (tree x dx (tree z dz zL xL) xR)))
  
  (defun left-heavy? (tr)
    (and (tree? tr)
         (not (empty-tree? tr))
         (= (height (left tr)) (+ 2 (height (right tr))))))
  
  (defun outside-left-heavy? (tr)
    (and (left-heavy? tr)
         (or (= (height (left (left tr)))
                (height (right (left tr))))
             (= (height (left (left tr)))
                (+ 1 (height (right (left tr))))))))
  
  (defun right-rotatable? (tr)
    (and (ordered? tr)
         (not (empty-tree? tr))
         (balanced? (left tr))
         (balanced? (right tr))
         (not (empty-tree? (left tr)))))
  
  (defun right-heavy? (tr)
    (and (tree? tr)
         (not (empty-tree? tr))
         (= (height (right tr)) (+ 2 (height (left tr))))))
  
  (defun outside-right-heavy? (tr)
    (and (right-heavy? tr)
         (or (= (height (right (right tr))) 
                (height (left (right tr))))
             (= (height (right (right tr))) 
                (+ 1 (height (left (right tr))))))))
  
  (defun left-rotatable? (tr)
    (and (tree? tr)
         (not (empty-tree? tr))
         (balanced? (left tr))
         (balanced? (right tr))
         (not (empty-tree? (right tr)))))
  
  (defun hard-R (tr)
    (let* ((z (key tr))
           (dz (data tr))
           (zL (left tr))
           (zR (right tr)))
      (easy-R (tree z dz (easy-L zL) zR))))
  
  (defun hard-L (tr)
    (let* ((z (key tr))
           (dz (data tr))
           (zL (left tr))
           (zR (right tr)))
      (easy-L (tree z dz zL (easy-R zR)))))
  
  (defun inside-left-heavy? (tr)
    (and (left-heavy? tr)
         (= (height (right (left tr)))
            (+ 1 (height (left (left tr)))))))
  
  (defun hard-R-rotatable? (tr)
    (and (right-rotatable? tr)
         (left-rotatable? (left tr))))
  
  (defun inside-right-heavy? (tr)
    (and (right-heavy? tr)
         (= (height (left (right tr)))
            (+ 1 (height (right (right tr)))))))
  
  (defun hard-L-rotatable? (tr)
    (and (left-rotatable? tr)
         (right-rotatable? (right tr))))
  
  (defun rot-R (tr)
    (let ((zL (left tr)))
      (if (< (height (left zL)) (height (right zL)))
          (hard-R tr)
          (easy-R tr))))
  
  (defun rot-L (tr)
    (let ((zR (right tr)))
      (if (< (height (right zR)) (height (left zR))) 
          (hard-L tr)
          (easy-L tr))))
  
  ; insertion
  (defun avl-insert (tr new-key new-datum)
    (if (empty-tree? tr)
        (tree new-key new-datum (empty-tree) (empty-tree))
        (if (key< new-key (key tr))
            (let* ((subL (avl-insert (left tr) new-key new-datum))
                   (subR (right tr))
                   (new-tr (tree (key tr) (data tr) subL subR)))
              (if (= (height subL) (+ (height subR) 2))
                  (rot-R new-tr)
                  new-tr))
            (if (key> new-key (key tr))
                (let* ((subL (left tr))
                       (subR (avl-insert (right tr) new-key new-datum))
                       (new-tr (tree (key tr) (data tr) subL subR)))
                  (if (= (height subR) (+ (height subL) 2))
                      (rot-L new-tr)
                      new-tr))
                (tree new-key new-datum (left tr) (right tr))))))
  
  ; delete root - easy case
  (defun easy-delete (tr)
    (right tr))
  
  ; tree shrinking
  (defun shrink (tr)
    (if (empty-tree? (right tr))
        (list (key tr) (data tr) (left tr))
        (let* ((key-data-tree (shrink (right tr)))
               (k (car key-data-tree))
               (d (cadr key-data-tree))
               (subL (left tr))
               (subR (caddr key-data-tree))
               (shrunken-tr (tree (key tr) (data tr) subL subR)))
          (if (= (height subL) (+ 2 (height subR)))
              (list k d (rot-R shrunken-tr))
              (list k d shrunken-tr)))))
  
  (defun raise-sacrum (tr)
    (let* ((key-data-tree (shrink (left tr)))
           (k (car key-data-tree))
           (d (cadr key-data-tree))
           (subL (caddr key-data-tree))
           (subR (right tr))
           (new-tr (tree k d subL subR)))
      (if (= (height subR) (+ 2 (height subL)))
          (rot-L new-tr)
          new-tr)))
  
  ; delete root - hard case
  (defun delete-root (tr)
    (if (empty-tree? (left tr))
        (easy-delete tr)
        (raise-sacrum tr)))

  ; deletion
  (defun avl-delete (tr k)
    (if (empty-tree? tr)
        tr
        (if (key< k (key tr))           ; key occurs in left subtree
            (let* ((new-left (avl-delete (left tr) k))
                   (new-tr (tree (key tr) (data tr) 
                                 new-left (right tr))))
              (if (= (height (right new-tr)) 
                     (+ 2 (height (left new-tr))))
                  (rot-L new-tr)
                  new-tr))
            (if (key> k (key tr))       ; key occurs in right subtree
                (let* ((new-right (avl-delete (right tr) k))
                       (new-tr (tree (key tr) (data tr) 
                                     (left tr) new-right)))
                  (if (= (height (left new-tr)) 
                         (+ 2 (height (right new-tr))))
                      (rot-R new-tr)
                      new-tr))
                (delete-root tr)))))  ; key occurs at root
  
  ; retrieval
  (defun avl-retrieve (tr k)  ; delivers key/data pair with key = k
    (if (empty-tree? tr)      ; or nil if k does not occur in tr
        nil               ; signal k not present in tree
        (if (key< k (key tr))
            (avl-retrieve (left tr) k)   ; search left subtree
            (if (key> k (key tr))
                (avl-retrieve (right tr) k) ; search right subtree
                (cons k (data tr))))))      ; k is at root, 
  ; deliver key/data pair
  
  (defun avl-flatten (tr)  ; delivers all key/data cons-pairs
    (if (empty-tree? tr)   ; with keys in increasing order
        nil
        (append (avl-flatten (left tr))
                (list (cons (key tr) (data tr)))
                (avl-flatten (right tr)))))
  
  (defun occurs-in-pairs? (k pairs)
    (and (consp pairs)
         (or (key= k (caar pairs))
             (occurs-in-pairs? k (cdr pairs)))))
  
  (defun increasing-pairs? (pairs)
    (or (not (consp (cdr pairs)))
        (and (key< (caar pairs) (caadr pairs))
             (increasing-pairs? (cdr pairs)))))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;AVL Tree Inner
  ;   This is the section for the inner AVL tree.  
  ;   It stores the key in the format of (Student ID)
  ;
  ;   - This is a modification of the original AVL Tree
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  (defun empty-tree-inner? (tr) (not (consp tr)))
  (defun height-inner (tr) (if (empty-tree-inner? tr) 0 (car tr)))
  (defun key-inner (tr) (cadr tr))
  (defun data-inner (tr) (caddr tr))
  (defun left-inner (tr) (cadddr tr))
  (defun right-inner (tr) (car (cddddr tr)))
  (defun keys-inner (tr)
    (if (empty-tree-inner? tr)
        nil
        (append (keys-inner (left-inner tr)) (list (key-inner tr)) (keys-inner (right-inner tr)))))
  
  ;checks if the string is <
  (defun check-if-less-inner (j k)
    (if (string< j k)
        t
        nil)     
    )
  
  ; Constructors
  (defun empty-tree-inner ( ) nil)
  (defun tree-inner (k d lf rt)
    (list (+ 1 (max (height-inner lf) (height-inner rt))) k d lf rt)) 
  
  ; Contstraint detectors and key comparators
  ;(defun key? (k) (rationalp k))	 ; to change representation of keys
  ;(defun key< (j k) (< j k))	  ;    alter definitions of key? and key<
  (defun key-inner? (k) 
    (and (rationalp k)))	 ; to change representation of keys
  
  ; j and k should be data points that look like '(make-posn 1 2)
  (defun key-inner< (j k)  ;    alter definitions of key? and key<
    (check-if-less-inner j k))
  ;(< j k))	  
  
  (defun key-inner> (j k) (key-inner< k j))
  (defun key-inner= (j k)		  ; note: definitions of
    (and (not (key-inner< j k))           ;    key>, key=, and key-member	
         (not (key-inner> j k))))	  ;        get in line automatically
  (defun key-member-inner (k ks)
    (and (consp ks)
         (or (key-inner= k (car ks))
             (key-member-inner k (cdr ks))))) 
  (defun data-inner? (d)
    (if d t t))
  (defun tree-inner? (tr)
    (or (empty-tree-inner? tr)
        (and (natp (height-inner tr))		       ; height-inner
             (= (height-inner tr)                           ; constraints
                (+ 1 (max (height-inner (left-inner tr))
                          (height-inner (right-inner tr)))))
             (key-inner? (key-inner tr))                     ; key-inner constraint
             (data-inner? (data-inner tr))                   ; data constraint
             (tree-inner? (left-inner tr))                   ; subtree
             (tree-inner? (right-inner tr)))))               ;   constraints
  
  ; Key occurs in tree detector
  (defun occurs-in-tree-inner? (k tr)
    (and (key-inner? k)
         (tree-inner? tr)
         (key-member-inner k (keys-inner tr))))
  (defun alternate-occurs-in-tree-inner? (k tr)
    (and (key-inner? k)
         (tree-inner? tr)
         (not (empty-tree-inner? tr))
         (or (key-inner= k (key-inner tr))
             (alternate-occurs-in-tree-inner? k (left-inner tr))
             (alternate-occurs-in-tree-inner? k (right-inner tr)))))
  
  ; all-key comparators
  (defun all-keys-inner< (k ks)
    (or (not (consp ks))
        (and (key-inner< (car ks) k) (all-keys-inner< k (cdr ks)))))
  
  (defun all-keys-inner> (k ks)
    (or (not (consp ks))
        (and (key-inner> (car ks) k) (all-keys-inner> k (cdr ks)))))
  
  ; definitions of ordered and balanced, and avl-tree detector
  (defun ordered-inner? (tr)
    (or (empty-tree-inner? tr)
        (and (tree-inner? tr)
             (all-keys-inner< (key-inner tr) (keys-inner (left-inner tr)))
             (all-keys-inner> (key-inner tr) (keys-inner (right-inner tr)))
             (ordered-inner? (left-inner tr))
             (ordered-inner? (right-inner tr)))))
  
  (defun balanced-inner? (tr)
    (and (tree-inner? tr)
         (or (empty-tree-inner? tr)
             (and (<= (abs (- (height-inner (left-inner tr)) 
                              (height-inner (right-inner tr)))) 1)
                  (balanced-inner? (left-inner tr))
                  (balanced-inner? (right-inner tr))))))
  
  (defun avl-tree-inner? (tr)
    (and (ordered-inner? tr)
         (balanced-inner? tr)))
  
  ; rotations
  (defun easy-R-inner (tr)
    (let* ((z (key-inner tr)) (dz (data-inner tr))
                              (zL (left-inner tr)) (zR (right-inner tr))
                              (x (key-inner zL)) (dx (data-inner zL))
                              (xL (left-inner zL)) (xR (right-inner zL)))
      (tree-inner x dx xL (tree-inner z dz xR zR))))
  
  (defun easy-L-inner (tr)
    (let* ((z (key-inner tr)) (dz (data-inner tr))
                              (zL (left-inner tr)) (zR (right-inner tr))
                              (x (key-inner zR)) (dx (data-inner zR))
                              (xL (left-inner zR)) (xR (right-inner zR)))
      (tree-inner x dx (tree-inner z dz zL xL) xR)))
  
  (defun left-heavy-inner? (tr)
    (and (tree-inner? tr)
         (not (empty-tree-inner? tr))
         (= (height-inner (left-inner tr)) (+ 2 (height-inner (right-inner tr))))))
  
  (defun outside-left-heavy-inner? (tr)
    (and (left-heavy-inner? tr)
         (or (= (height-inner (left-inner (left-inner tr)))
                (height-inner (right-inner (left-inner tr))))
             (= (height-inner (left-inner (left-inner tr)))
                (+ 1 (height-inner (right-inner (left-inner tr))))))))
  
  (defun right-rotatable-inner? (tr)
    (and (ordered-inner? tr)
         (not (empty-tree-inner? tr))
         (balanced-inner? (left-inner tr))
         (balanced-inner? (right-inner tr))
         (not (empty-tree-inner? (left-inner tr)))))
  
  (defun right-heavy-inner? (tr)
    (and (tree-inner? tr)
         (not (empty-tree-inner? tr))
         (= (height-inner (right-inner tr)) (+ 2 (height-inner (left-inner tr))))))
  
  (defun outside-right-heavy-inner? (tr)
    (and (right-heavy-inner? tr)
         (or (= (height-inner (right-inner (right-inner tr))) 
                (height-inner (left-inner (right-inner tr))))
             (= (height-inner (right-inner (right-inner tr))) 
                (+ 1 (height-inner (left-inner (right-inner tr))))))))

  (defun left-rotatable-inner? (tr)
    (and (tree-inner? tr)
         (not (empty-tree-inner? tr))
         (balanced-inner? (left-inner tr))
         (balanced-inner? (right-inner tr))
         (not (empty-tree-inner? (right-inner tr)))))
  
  (defun hard-R-inner (tr)
    (let* ((z (key-inner tr))
           (dz (data-inner tr))
           (zL (left-inner tr))
           (zR (right-inner tr)))
      (easy-R-inner (tree-inner z dz (easy-L-inner zL) zR))))
  
  (defun hard-L-inner (tr)
    (let* ((z (key-inner tr))
           (dz (data-inner tr))
           (zL (left-inner tr))
           (zR (right-inner tr)))
      (easy-L-inner (tree-inner z dz zL (easy-R-inner zR)))))
  
  (defun inside-left-heavy-inner? (tr)
    (and (left-heavy-inner? tr)
         (= (height-inner (right-inner (left-inner tr)))
            (+ 1 (height-inner (left-inner (left-inner tr)))))))
  
  (defun hard-R-rotatable-inner? (tr)
    (and (right-rotatable-inner? tr)
         (left-rotatable-inner? (left-inner tr))))
  
  (defun inside-right-heavy-inner? (tr)
    (and (right-heavy-inner? tr)
         (= (height-inner (left-inner (right-inner tr)))
            (+ 1 (height-inner (right-inner (right-inner tr)))))))
  
  (defun hard-L-rotatable-inner? (tr)
    (and (left-rotatable-inner? tr)
         (right-rotatable-inner? (right-inner tr))))
  
  (defun rot-R-inner (tr)
    (let ((zL (left-inner tr)))
      (if (< (height-inner (left-inner zL)) (height-inner (right-inner zL)))
          (hard-R-inner tr)
          (easy-R-inner tr))))
  
  (defun rot-L-inner (tr)
    (let ((zR (right-inner tr)))
      (if (< (height-inner (right-inner zR)) (height-inner (left-inner zR))) 
          (hard-L-inner tr)
          (easy-L-inner tr))))
  
  ; insertion
  (defun avl-insert-inner (tr new-key new-datum)
    (if (empty-tree-inner? tr)
        (tree-inner new-key new-datum (empty-tree-inner) (empty-tree-inner))
        (if (key-inner< new-key (key-inner tr))
            (let* ((subL (avl-insert-inner (left-inner tr) new-key new-datum))
                   (subR (right-inner tr))
                   (new-tr (tree-inner (key-inner tr) (data-inner tr) subL subR)))
              (if (= (height-inner subL) (+ (height-inner subR) 2))
                  (rot-R-inner new-tr)
                  new-tr))
            (if (key-inner> new-key (key-inner tr))
                (let* ((subL (left-inner tr))
                       (subR (avl-insert-inner (right-inner tr) new-key new-datum))
                       (new-tr (tree-inner (key-inner tr) (data-inner tr) subL subR)))
                  (if (= (height-inner subR) (+ (height-inner subL) 2))
                      (rot-L-inner new-tr)
                      new-tr))
                (tree-inner new-key new-datum (left-inner tr) (right-inner tr))))))
  
  ; delete root - easy case
  (defun easy-delete-inner (tr)
    (right-inner tr))
  
  ; tree shrinking
  (defun shrink-inner (tr)
    (if (empty-tree-inner? (right-inner tr))
        (list (key-inner tr) (data-inner tr) (left-inner tr))
        (let* ((key-data-tree (shrink-inner (right-inner tr)))
               (k (car key-data-tree))
               (d (cadr key-data-tree))
               (subL (left-inner tr))
               (subR (caddr key-data-tree))
               (shrunken-tr (tree-inner (key-inner tr) (data-inner tr) subL subR)))
          (if (= (height-inner subL) (+ 2 (height-inner subR)))
              (list k d (rot-R-inner shrunken-tr))
              (list k d shrunken-tr)))))
  
  (defun raise-sacrum-inner (tr)
    (let* ((key-data-tree (shrink-inner (left-inner tr)))
           (k (car key-data-tree))
           (d (cadr key-data-tree))
           (subL (caddr key-data-tree))
           (subR (right-inner tr))
           (new-tr (tree-inner k d subL subR)))
      (if (= (height-inner subR) (+ 2 (height-inner subL)))
          (rot-L-inner new-tr)
          new-tr)))
  
  ; delete root - hard case
  (defun delete-root-inner (tr)
    (if (empty-tree-inner? (left-inner tr))
        (easy-delete-inner tr)
        (raise-sacrum-inner tr)))
  
  ; deletion
  (defun avl-delete-inner (tr k)
    (if (empty-tree-inner? tr)
        tr
        (if (key-inner< k (key-inner tr))           ; key occurs in left subtree
            (let* ((new-left (avl-delete-inner (left-inner tr) k))
                   (new-tr (tree-inner (key-inner tr) (data-inner tr) 
                                       new-left (right-inner tr))))
              (if (= (height-inner (right-inner new-tr)) 
                     (+ 2 (height-inner (left-inner new-tr))))
                  (rot-L-inner new-tr)
                  new-tr))
            (if (key-inner> k (key-inner tr))       ; key occurs in right subtree
                (let* ((new-right (avl-delete-inner (right-inner tr) k))
                       (new-tr (tree-inner (key-inner tr) (data-inner tr) 
                                           (left-inner tr) new-right)))
                  (if (= (height-inner (left-inner new-tr)) 
                         (+ 2 (height-inner (right-inner new-tr))))
                      (rot-R-inner new-tr)
                      new-tr))
                (delete-root-inner tr)))))  ; key occurs at root
  
  ; retrieval
  (defun avl-retrieve-inner (tr k)  ; delivers key/data pair with key = k
    (if (empty-tree-inner? tr)      ; or nil if k does not occur in tr
        nil               ; signal k not present in tree
        (if (key-inner< k (key-inner tr))
            (avl-retrieve-inner (left-inner tr) k)   ; search left subtree
            (if (key-inner> k (key-inner tr))
                (avl-retrieve-inner (right-inner tr) k) ; search right subtree
                (cons k (data-inner tr))))))      ; k is at root, 
  ; deliver key/data pair
  
  (defun avl-flatten-inner (tr)  ; delivers all key/data cons-pairs
    (if (empty-tree-inner? tr)   ; with keys in increasing order
        nil
        (append (avl-flatten-inner (left-inner tr))
                (list (cons (key-inner tr) (data-inner tr)))
                (avl-flatten-inner (right-inner tr)))))
  
  (defun occurs-in-pairs-inner? (k pairs)
    (and (consp pairs)
         (or (key-inner= k (caar pairs))
             (occurs-in-pairs-inner? k (cdr pairs)))))
  
  (defun increasing-pairs-inner? (pairs)
    (or (not (consp (cdr pairs)))
        (and (key-inner< (caar pairs) (caadr pairs))
             (increasing-pairs-inner? (cdr pairs)))))
  
  (defun get-score (xs)
    (cons xs 5)
    )
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;AVL Tree Module
  ;   This function is the heart of the program.  It calls both random generator and formulas to calculate
  ;     the correct teams
  ;  Our AVL Module to manipulate the AVL tree
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;create-y
  ;input: (create-y 110 '(111 112 113))
  ;output: ((110 . 111) (110 . 112) (110 . 113))
  (defun create-y (x ys)
    (if (consp ys)
        (cons (list x (car ys)) (create-y x (cdr ys)))
        nil)
    )
  ;create=x
  ;input: (create-x '(110 111 112) '(113 114 115))
  ;output: (((110 . 113) (110 . 114) (110 . 115)) ((111 . 113) (111 . 114) (111 . 115)) ((112 . 113) (112 . 114) (112 . 115)))
  (defun create-x (xs ys)
    (if (consp xs)
        (cons (create-y (car xs) ys) (create-x (cdr xs) ys))
        nil
        )
    )
  
  ;find-all-combination-helper
  (defun find-all-combination-helper (xs)
    (if (consp xs)
        (cons (car xs) (find-all-combination-helper (cdr xs)))
        nil)
    )
  
  ;find-all-possible-combinations
  (defun find-best-combination (xs)
    (if (consp xs)
        (cons (find-all-combination-helper (car xs)) (find-best-combination (cdr xs)))
        nil)
    )
  
  ;create-all-possible-combinations
  (defun create-all-possible-combinations (xs ys)
    (find-best-combination (create-x xs ys))    
    )
  
  ;compare-student-id
  (defun compare-student-id (value x y)
    (if (consp x)
        (if (char-equal (car x) (car y))
            (compare-student-id t (cdr x) (cdr y))
            nil)
        value)
    )
  
  ;remove-nth-student-helper
  (defun remove-nth-student-helper (i pos xs)
    (if (= i pos)
        nil
        (car xs)
        )
    )
  
  ;remove-nth-student
  ;removes the student specified
  (defun remove-nth-student (i pos xs)
    (if (consp xs)
        (remove nil (cons (remove-nth-student-helper i pos xs) (remove-nth-student (+ i 1) pos (cdr xs))))
        nil
        )
    )
  
  ;randomize-list
  (defun randomize-list (seed list)
    (if (consp list)
        (cons (nth (car (get-random-number-mod-max seed (len list))) list)
              (randomize-list (car (get-random-number-mod-max seed (len list))) (remove-nth-student 0 (car (get-random-number-mod-max seed (len list))) list)))
        nil))
  
  
  ;remove-recurrences-helper
  (defun remove-recurrence-helper (x ys)
    (if (consp ys)
        ;(if (not (string-equal (chrs->str (car x)) (chrs->str (caar ys))))
        ;(if (not (string-equal (chrs->str (car x)) (chrs->str (caar ys))))
        (if (not (string-equal (car x) (caar ys)))
            (cons (car ys) (remove-recurrence-helper x (cdr ys)))
            (remove-recurrence-helper x (cdr ys)))
        nil))
  
  ;remove-recurrence
  ;input: (remove-recurrence (car (randomize-list 30 (get-students-as-data "input.txt"))) (randomize-list 30 (get-students-as-data "input.txt")))
  (defun remove-recurrence (xs ys)
    (if (consp xs)
        (remove-recurrence (cdr xs) (remove-recurrence-helper (car xs) ys))
        ys))
  
  ;inner-iterator
  ; puts all items from list into avl-tree and organizes them by student id
  ; (inner-iterator (get-students-as-data "input.txt"))
  (defun inner-iterator (inner-tree list)
    (if (consp list)
        (avl-insert-inner 
         (inner-iterator 
          inner-tree 
          (cdr list))
         ;(chrs->str (caar list))
         (caar list)
         (cdr (car list)))
        nil))
  
  ;random-student-from-list
  ;this function is a helper function to the groups-from-list-of-students
  ;it returns a random student from the list of students
  (defun random-student-from-list (list-of-students seed)
    (let ((first-part (car (break-at-nth (car (get-random-number-mod-max seed 
                                                                         (len list-of-students))) list-of-students)))
          (second-part (cdadr (break-at-nth (car (get-random-number-mod-max seed 
                                                                            (len list-of-students))) list-of-students)))
          (next-student (caadr (break-at-nth (car (get-random-number-mod-max seed 
                                                                             (len list-of-students))) list-of-students))))
      (list next-student (append first-part second-part) (cdr (get-random-number-mod-max seed 
                                                                                         (len list-of-students))))
      )
    )
  
  ;groups-from-list-of-students
  ; Call using initial-group
  ; ie (groups-from-list-of-students '("a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k") (initial-groups 4) 4 0 55235)
  ;(groups-from-list-of-students (avl-flatten-inner (inner-iterator 3 (get-students-as-data "input.txt"))) (initial-groups 4) 4 0 55235)
  (defun groups-from-list-of-students (list-of-students groups num-groups cur-group seed)
    (if (consp list-of-students)
        (let ((first-part (car (break-at-nth (mod cur-group num-groups) groups)))
              (second-part (cdadr (break-at-nth (mod cur-group num-groups) groups)))
              (next-group (caadr (break-at-nth (mod cur-group num-groups) groups)))
              (next-student (car (random-student-from-list list-of-students seed)))
              (next-student-list (cadr (random-student-from-list list-of-students seed)))
              (next-seed (caddr (random-student-from-list list-of-students seed))))
          (groups-from-list-of-students next-student-list 
                                        (append first-part (list (cons next-student next-group)) second-part)
                                        num-groups (+ 1 cur-group) seed)
          )
        groups
        )
    )
  
  ;throw-into-tree-helper
  ;  this funciton is a helper function to throw-into-tree.
  ;  it takes the inner tree of students from the group and manipulates it
  ;(throw-into-tree-helper 0 (len (car (groups-from-list-of-students (avl-flatten-inner (inner-iterator 3 (get-students-as-data "input.txt"))) (initial-groups 4) 4 0 55235))) (car (groups-from-list-of-students (avl-flatten-inner (inner-iterator 3 (get-students-as-data "input.txt"))) (initial-groups 4) 4 0 55235)) (empty-tree-inner))
  (defun throw-into-tree-helper (i length-list inner-masterlist avl-inner)
    (if (< i length-list)
        (avl-insert-inner (throw-into-tree-helper (+ 1 i) length-list (cdr inner-masterlist) avl-inner) (caar inner-masterlist) (cdr (car inner-masterlist)))
        avl-inner))
  
  ;throw-into-tree
  ;  throw 
  ;(throw-into-tree 0 4 (groups-from-list-of-students (avl-flatten-inner (inner-iterator 3 (get-students-as-data "input.txt"))) (initial-groups 4) 4 0 55235) (empty-tree-inner))
  (defun throw-into-tree (i num-groups masterlist avl-inner avl-outer)
    (if (consp masterlist)
        (avl-insert (throw-into-tree (+ i 1) num-groups (cdr masterlist) avl-inner avl-outer) (list i 0) (throw-into-tree-helper 0 (- (len (car masterlist)) 1) (car masterlist) (empty-tree-inner)))
        avl-outer))
  
  ;initial-groups
  (defun initial-groups (num-groups)
    (if (not (equal num-groups 0))
        (append (list (list nil)) (initial-groups (- num-groups 1)))
        nil
        )
    )
  
  ;store-total-loops
  (defun store-total-loops (i max)
    (if (< i max)
        (cons 1 (store-total-loops (+ i 1) max))
        nil))
  
  ;return-flat-inner-tree
  (defun return-flat-inner-tree (i score avl-tree)
    (avl-retrieve avl-tree (list i score))
    )
  
  ;return-flat-outer-tree
  (defun return-flat-outer-tree (avl-tree)
    (avl-flatten avl-tree)
    )
  
  ;return-largest-key-pair
  (defun return-worst-and-random-key-pair (avl-tree seed)
    (let ((worst-team (caar (return-flat-outer-tree avl-tree)))
          (rest-of-them (cdr (return-flat-outer-tree avl-tree))))
      (list worst-team (caaadr (break-at-nth 
                                (car (get-random-number-mod-max seed (len rest-of-them))) rest-of-them)))
      )
    )
  
  ;return-top-key-pair
  (defun return-top-key-pair (avl-tree)
    (caar (return-flat-outer-tree avl-tree)))
  
  ;calculate-team-score-temp
  (defun calculate-team-score-temp (a b c d)
    (list a (car (cdr '((2 0) 30)))))
  
  ;(calculate-team-score (list i 0) (avl-flatten-inner (cdr (avl-retrieve (initialize-teams (+ i 1) master-avl list-of-actual-weights specifications)
  ;(defun initialize-teams (i num-teams master-avl list-weights spec avl-tree)
  ;  (avl-insert (avl-delete master-avl (list i 0))
  ;              (list i (car (cdr (calculate-team-score-temp (list i 0) (avl-flatten-inner (cdr (avl-retrieve master-avl (list i 0)))) list-weights spec))))
  ;              (cdr (avl-retrieve master-avl (list i 0))))
  ;  )
  
  ;(initialize-teams 0 4 (form-initial-tree (get-students-as-data "input.txt") 4 0 0 23434) '(("SKILL SET" 2/5 ("java" "c/c++" "haskell" "acl2")) ("team interaction skills" 3/5 ("communication and negotiation" "analytic and creative" "organization"))) '(0.3 0.4 0.2 0.8) (empty-tree))
  (defun initialize-teams (i num-teams master-avl list-weights spec avl-tree)
    (if (< i num-teams)
        (initialize-teams (+ i 1) num-teams master-avl
                          list-weights spec
                          (avl-insert avl-tree
                                      (list i (car (cdr (calculate-team-score (list i 0)
                                                                              (avl-flatten-inner (cdr
                                                                                                  (avl-retrieve master-avl (list i 0))))
                                                                              list-weights spec))))
                                                                              (cdr (avl-retrieve master-avl (list i 0)))))
                                      
        avl-tree)
    )
  
  ;pull-out-students-from-worst-random
  (defun pull-out-students-from-worst-random (seed avl-tree pair)
    (list (keys-inner (cdr (avl-retrieve avl-tree (car pair)))) (keys-inner (cdr (avl-retrieve avl-tree (car (cdr pair)))))))
  ;(avl-retrieve-inner (cdr (avl-retrieve avl-tree (car pair))) "111111113 "))
  
  ;combinations-between-worst-random
  ;(combinations-between-worst-random 40 (empty-tree-inner) (empty-tree-inner) (form-initial-tree (get-students-as-data "input.txt") 4 '(0.3 0.4 0.2 0.8) '(("SKILL SET" 2/5 ("java" "c/c++" "haskell" "acl2")) ("team interaction skills" 3/5 ("communication and negotiation" "analytic and creative" "organization"))) 23434))
  (defun combinations-between-worst-random (seed avl-tree)
    (create-all-possible-combinations (car (pull-out-students-from-worst-random seed avl-tree (return-worst-and-random-key-pair avl-tree seed)))
                                      (car (cdr (pull-out-students-from-worst-random seed avl-tree (return-worst-and-random-key-pair avl-tree seed)))))
    )
  
  ;simplify
  (defun simplify (xs)
    (if (consp xs)
        (append (car xs) (simplify (cdr xs)))
        nil))
  
  ;calculate-permutation
  ;calculates all of the permutations of the two groups you are switching between.
  (defun calculate-permutation (permutations avl-tree seed list-weights spec)
    (if (consp permutations)
        (let* ((return-first-inside-tree (cdr (avl-retrieve avl-tree (car (return-worst-and-random-key-pair avl-tree seed))))) ;(first-perm-student))
               (return-second-inside-tree (cdr (avl-retrieve avl-tree (car (cdr (return-worst-and-random-key-pair avl-tree seed))))))
               (1st-student (cdr (avl-retrieve-inner return-first-inside-tree (car (car permutations)))))
               (2nd-student (cdr (avl-retrieve-inner return-second-inside-tree (car (cdr (car permutations))))))
               (new-worst-team (avl-insert-inner (avl-delete-inner return-first-inside-tree (car (car permutations))) 
                                                 (car (cdr (car permutations))) 2nd-student))
               (new-random-team (avl-insert-inner (avl-delete-inner return-second-inside-tree (car (cdr (car permutations)))) 
                                                  (car (car permutations)) 1st-student)) 
               (new-worst-team-score (calculate-team-score (car (return-worst-and-random-key-pair avl-tree seed)) (avl-flatten-inner new-worst-team) list-weights spec))   
               (new-random-team-score (calculate-team-score (car (cdr (return-worst-and-random-key-pair avl-tree seed))) (avl-flatten-inner new-random-team) list-weights spec)))
          (cons (list (list (car (car permutations)) new-worst-team-score) 
                      (list (car (cdr (car permutations))) new-random-team-score)) 
                (calculate-permutation (cdr permutations) avl-tree seed list-weights spec))) 
        nil
        )
    )
  
  ;get-current-maximum-pair-helper
  ;helps the get-current-maximum-pair function
(defun get-current-maximum-pair-helper (best list-of-pairs curBest)
  (if (consp list-of-pairs)
      (if (> (cadr (cadaar list-of-pairs)) best)
          (get-current-maximum-pair-helper best (cdr list-of-pairs) (car list-of-pairs))
          (get-current-maximum-pair-helper best (cdr list-of-pairs) curBest)
      )
      curBest
  )
)
  
  ;get-current-maximum-pair
  ;gets the maximum current score of the list-of-pairs
(defun get-current-maximum-pair (list-of-pairs)
  (get-current-maximum-pair-helper (cadar list-of-pairs) (cdr list-of-pairs) nil)
)

  
  
  ;compare-with-original
  ;compares the old team score to the new team score
  (defun compare-with-original (permutations avl-tree seed list-weights spec)
    (cons (calculate-team-score (caar (avl-flatten avl-tree)) (avl-flatten-inner (cdr (car (avl-flatten avl-tree)))) list-weights spec) (calculate-permutation permutations avl-tree seed list-weights spec))
    )
  
  ;update-tree-with-new
  ;go through and update the tree by switching the students around from the permutations
  (defun update-tree-with-new (pair avl-tree)
    (let* ((1st-item-original-pair (caar (cdr (car pair))))
           (1st-item-new-score (car (cdr (car (cdr (car pair))))))
           (1st-item-inner-key (caar pair))
           (2nd-item-original-pair (car (car (cdr (car (cdr pair))))))
           (2nd-item-new-score (car (cdr (car (cdr (car (cdr pair)))))))
           (2nd-item-inner-key (caar (cdr pair)))
           (1st-avl-inner-tree (cdr (avl-retrieve avl-tree 1st-item-original-pair)))
           (2nd-avl-inner-tree (cdr (avl-retrieve avl-tree 2nd-item-original-pair)))
           (1st-avl-inner-tree-updated 
            (avl-insert-inner (avl-delete-inner 1st-avl-inner-tree 1st-item-inner-key) 
                              2nd-item-inner-key (cdr (avl-retrieve-inner 2nd-avl-inner-tree 2nd-item-inner-key))))
           (2nd-avl-inner-tree-updated 
            (avl-insert-inner (avl-delete-inner 2nd-avl-inner-tree 2nd-item-inner-key) 
                              1st-item-inner-key (cdr (avl-retrieve-inner 1st-avl-inner-tree 1st-item-inner-key))))
           (avl-main-tree (avl-delete (avl-delete avl-tree 1st-item-original-pair) 2nd-item-original-pair))
           (avl-main-tree-update (avl-insert 
                                  (avl-insert avl-main-tree (list (car 1st-item-original-pair) 1st-item-new-score)
                                              1st-avl-inner-tree-updated) (list (car 2nd-item-original-pair) 2nd-item-new-score)
                                                                          2nd-avl-inner-tree-updated))
           ;(new-main-tree         (avl-delete (avl-insert avl-tree (list (car 1st-item-original-pair) 1st-item-new-score)  1st-avl-inner-tree-updated) 1st-item-original-pair))
           ;(new-main-tree-updated (avl-insert new-main-tree (list (car 2nd-item-original-pair) 2nd-item-new-score) 2nd-avl-inner-tree-updated))
           )
      ; 1st-item-original-pair)
      avl-main-tree-update)
    )
  
  
  ;create-all-combinations
  ;takes in the permulations of the two student files that you are switching
  ;compares the scores of the resulting tree to see if the original tree or the new updated tree is bigger or smaller
  ;returns the one with the greatest score to attempt to maximize score
  (defun create-all-combinations (permutations avl-tree seed list-weights spec)
    (let* ((selection (get-current-maximum-pair (compare-with-original permutations avl-tree seed list-weights spec))))
      (if (not selection)
          avl-tree
          (update-tree-with-new selection avl-tree) ;return updated tree
          )
      )
    ) 
;  
;  ;flatten-inner-tree
;  ;helpter function for the flatten-all-trees - goes through to flatten the inner trees
;  (defun flatten-inner-tree (the-outer-keys master-avl-tree avl-tree)
;    (if (consp the-outer-keys)
;        (avl-insert (flatten-inner-tree (cdr the-outer-keys) master-avl-tree avl-tree) (car the-outer-keys) (avl-flatten-inner (cdr (avl-retrieve master-avl-tree (car the-outer-keys)))))
;        avl-tree
;        )
;    )
;  
;  ;flatten-all-trees
;  ;runs through and flattens all of the trees
;  (defun flatten-all-trees (avl-tree)
;    (let* ((all-outer-keys (keys avl-tree)))
;      (avl-flatten (flatten-inner-tree all-outer-keys avl-tree (empty-tree)))))
  
  (defun flatten-all-tree-helper (keys students)
    (if (consp keys)
        (cons (cons (car keys) (avl-flatten-inner (car students)))
              (flatten-all-tree-helper (cdr keys) (cdr students)))
        nil
        )
  )
  
  (defun flatten-all-tree (avl-tree)
    (let* ((flattened-whole-tree (avl-flatten avl-tree))
           (keys (strip-cars flattened-whole-tree))
           (students (strip-cdrs flattened-whole-tree)))
      (flatten-all-tree-helper keys students)))
  
  
  ;form-initial-tree
  ;parameters
  ;  input:  list-of-students: complete list of all the students
  ;          list-of-spec: all the parameters that belong to each student
  ;          seed:  seed for random number generator
  ;  output: complete avl tree with randomized teams   
  
  ;(form-initial-tree (get-students-as-data "input.txt") 4 0 0 23434)
  ;(form-initial-tree (get-students-as-data "input.txt") 4 '(0.3 0.4 0.2 0.8) '(("SKILL SET" 2/5 ("java" "c/c++" "haskell" "acl2")) ("team interaction skills" 3/5 ("communication and negotiation" "analytic and creative" "organization"))) 23434)
  (defun form-initial-tree (list-of-students num-teams list-of-actual-weights specifications seed)
    ;(create-all-combinations
    (let* ((init-tree 
            (initialize-teams 0 
                                        num-teams 
                                        (throw-into-tree 0 num-teams 
                                                         (groups-from-list-of-students (avl-flatten-inner (inner-iterator 0 list-of-students)) (initial-groups num-teams) num-teams 0 seed) (empty-tree) (empty-tree-inner)
                                                         )
                                       list-of-actual-weights
                                       specifications
                                       (empty-tree))
                                        ))
     (flatten-all-tree
      ; (simplify (combinations-between-worst-random seed 
        ;                                            init-tree))
       (create-all-combinations (simplify (combinations-between-worst-random seed init-tree))
                           init-tree 
                                seed
                                list-of-actual-weights
                                specifications)
       )
     )
    )
  (export IAVLtree)
  )
